Introduction

Évaluation de la gaine du nerf optique par échographie dans l’Artérite à Cellules géantes

Recherche non interventionnelle ne comportant aucun risque ni contrainte

Étude diagnostique non interventionnelle, prospective multicentrique

Investigateur Coordonnateur
Omar AL TABAA — Rhumatologie Hôpital NOVO (Site de Pontoise)

Comité scientifique
Maxime SANSOM — Service de médecine interne CHU Dijon
Sébastien OTTAVIANI — Service de rhumatologie hôpital Bichat (Paris)
Olivier ESPITIA — Service de médecine vasculaire CHU Nantes

Chef de projet
Mathilde WLODARCZY — USRC

Méthodologiste
Chrystelle VIDAL — GIRCI Île de France

Data-manager
Nathanaël CHARRIER — USRC

Statisticien
Philippe MICHEL — USRC

#
# setup
#

library(tidyverse)
library(baseph)
library(labelled)
library(readODS)
library(janitor)
library(kableExtra)
library(gtsummary)
library(plotly)

classeur <- "petrusvalid.ods"
expx <- FALSE
if (expx) {
  file.create(classeur)
  file.remove(classeur)
  write_ods(iris, classeur)
}

# sessionInfo()

theme_gtsummary_language(language = "fr", decimal.mark = ",")
theme_gtsummary_journal(journal = "jama")
options(OutDec = ",")
ptest <- list(all_continuous() ~ "t.test", all_categorical() ~ "chisq.test")
ptest2 <- list(all_continuous() ~ "paired.t.test", all_categorical() ~ "chisq.test")
stt <- list(
  all_continuous() ~ "{mean} ({sd})",
  all_categorical() ~ "{n}/{N} ({p}%)")

#
# Importation des données 
#
library(tidyverse)
library(baseph)
library(readODS)
library(labelled)
library(janitor)
#
# Concordance intra
#

nad <- c("", " ", "NA", "ND")

intra <- read_ods("datas/concordance_intra.ods", 
                  na = nad) |> 
    clean_names() |>
  mutate(across(where(is.character), as.factor))
bn <- read_ods("datas/concordance_intra.ods", 
                sheet = 2)
var_label(intra) <- bn$titre
#
# Concordance technique
#
tech <- read_ods("datas/concordance_techniques.ods", 
                  na = nad) |> 
    clean_names() |>
  mutate(across(where(is.character), as.factor))
bn <- read_ods("datas/concordance_techniques.ods", 
                sheet = 2)
var_label(tech) <- bn$titre
#
# Validation mesures
#
tt <- read_ods("datas/validation-mesures.ods", 
                  na = nad) |> 
    clean_names() |>
  mutate(across(where(is.character), as.factor))
bn <- read_ods("datas/validation-mesures.ods", 
                sheet = 2)
var_label(tt) <- bn$titre
#

Concordance intra-observateur

Les données ne sont présentes que pour un seul des experts.

On considère qu’il y a une erreur dans les mesures si la différence entre les deux mesures est supérieure à 1 mm.

#
# Préparation des données 
#
intra2 <- intra |> 
  pivot_longer(names_to = "structure", values_to = "value", cols = nerf_droit:gaine_gauche) |> 
  pivot_wider(names_from = "relecture", values_from = "value") |> 
  ## Recodage de zz$structure
mutate(structure = fct_recode(structure,
    "gaine du nerf optique" = "gaine_droit",
    "gaine du nerf optique" = "gaine_gauche",
    "nerf optique" = "nerf_droit",
    "nerf optique" = "nerf_gauche"
  )) |> 
mutate(dif = abs( R_1 - R_2)) |> 
mutate(erreur = as.factor(ifelse(dif > 0.999,"Erreur","Correct"))) |> 
  drop_na(dif) 
intra2 <- droplevels(intra2)
var_label(intra2$dif) <-  "Différence des mesures"
var_label(intra2$erreur) <-  "Erreur de mesure"

tab <-intra2 |> 
dplyr::filter(structure == "nerf optique") |> 
dplyr::select(dif, erreur) |> 

 tbl_summary(missing = "no",
              type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
  add_n() |> 
  bold_labels() |>
  modify_header(label ~ " ") |> 
   modify_spanning_header(c("stat_0") ~ "**Nerf optique**") 
  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "intra-tab1n", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))

Concordance intra-observateur

		Nerf optique
	N	N = 20
Différence des mesures	20
Moyenne ± ET		0.33 ± 0.26
Min, Max		0.01, 0.92
Erreur de mesure, n (%)	20
Correct		20 (100)

intra2 |> 
dplyr::filter(structure != "nerf optique") |> 
dplyr::select( dif, erreur) |> 

tbl_summary(missing = "no",
              type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
     modify_spanning_header(c("stat_0") ~ "**Gaine du nerf optique**") |>
  add_n() |> 
  bold_labels() |>
  modify_header(label ~ " ") 

	N	Gaine du nerf optique
		N = 20
Différence des mesures	20
Moyenne ± ET		0.22 ± 0.14
Min, Max		0.01, 0.69
Erreur de mesure, n (%)	20
Correct		20 (100)

  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "intra-tab1g", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))

Concordance intra-observateur

		Nerf optique
	N	N = 20
Différence des mesures	20
Moyenne ± ET		0.33 ± 0.26
Min, Max		0.01, 0.92
Erreur de mesure, n (%)	20
Correct		20 (100)

La concordance des deux mesures tend à valider la qualité des mesures. Les mesures semblent plus reproductibles pour la gaine du nerf optique que pour le nerf optique.

intra2 |> 
  ggplot() + 
  aes(x = dif, fill = structure) |> 
  geom_density(alpha = .7) +
        labs(
      title = "Différence entre les deux mesures",
      x = "mm", 
      caption = "Différence mesure 2 / mesure 1"
    ) +
    theme_light() +
    theme(
      plot.title = element_text(size = 18, face = "bold"),
      plot.subtitle = element_text(size = 12),
      axis.title.x = element_text(size = 12),
      axis.title.y = element_blank(),
      axis.text.x = element_text(size = 12),
      axis.text.y = element_text(size = 12),
      legend.position = "top"
    )

Figure 1: Différence entre les deux mesures

#| label: fig-intra2
#| fig-cap: Différence entre les deux mesures

zz <- intra2 |> 
  ggplot() + 
  aes(x = structure, y = dif, fill = structure) |> 
  geom_violin() +
        labs(
      title = "Différence entre les deux mesures",
      x = "Structure", 
      y ="mm",
      caption = "Différence mesure 2 / mesure 1"
    ) +
    theme_light() +
    theme(
      plot.title = element_text(size = 18, face = "bold"),
      plot.subtitle = element_text(size = 12),
      axis.title.x = element_text(size = 12),
      axis.title.y = element_text(size = 12),
      axis.text.x = element_text(size = 12),
      axis.text.y = element_text(size = 12),
      legend.position = "none"
    )

ggplotly(zz)

Concordance technique

On compare ici deux méthode de mesure : technique habituelle vs mesure à l’interface du vitré.

#
# Concordance technique :préparation des données
#
tech2 <- tech |> 
  pivot_longer(names_to = "structure", values_to = "value", cols = nerf_droit:gaine_gauche) |> 
  pivot_wider(names_from = "technique", values_from = "value") |> 
  mutate(structure = fct_recode(structure,
                                "gaine du nerf optique" = "gaine_droit",
                                "gaine du nerf optique" = "gaine_gauche",
                                "nerf optique" = "nerf_droit",
                                "nerf optique" = "nerf_gauche"
  )) |> 
  mutate(dif = abs(habituelle -`Interface vitré`)) |> 
  mutate(erreur = as.factor(ifelse(dif > 0.999,"Erreur","Correct"))) |> 
  drop_na(dif)
var_label(tech2$dif) <-  "Différence des mesures"

cot <- rep(c("d","d","g","g"),20)

 zz <- tech2 |> 
dplyr::filter(structure == "nerf optique") |> 
mutate(id = as.factor(paste0(centre, expert,coupe))) |> 
dplyr::select(id, habituelle:`Interface vitré`) |> 
pivot_longer(cols = habituelle :`Interface vitré`)  |> 
mutate(id = paste0(id,cot)) |> 
mutate(name = as.factor(name)) |> 
drop_na() 
tab <- zz |> 
  tbl_summary(by = name, 
              include = -id,
              type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
  add_p(test = list(
          all_continuous() ~ "paired.t.test"),
        group = id) |> 
    add_n() |> 
  bold_labels() |>
  bold_p() |> 
  modify_header(label ~ "**Nerf optique**") 
  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "tab-tech1n", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))

Concordance technique

Nerf optique	N	habituelle N = 95	Interface vitré N = 95	p-valeur
value	190			<0,001
Moyenne ± ET		3.43 ± 0.41	3.24 ± 0.38
Min, Max		2.30, 4.40	2.20, 4.40
1 Paired t-test

zg <- tech2 |> 
dplyr::filter(structure != "nerf optique") |> 
mutate(id = as.factor(paste0(centre, expert,coupe))) |> 
dplyr::select(id, habituelle:`Interface vitré`) |> 
pivot_longer(cols = habituelle :`Interface vitré`)  |> 
mutate(id = paste0(id,cot)) |> 
mutate(name = as.factor(name)) |> 
drop_na() 
tab <- zg |> 
  tbl_summary(by = name, 
              include = -id,
              type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
  add_p(test = list(
          all_continuous() ~ "paired.t.test"),
        group = id) |> 
      add_n() |> 
  bold_labels() |>
  bold_p() |> 
  modify_header(label ~ "**Gaine du nerf optique**") 

  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "tab-tech1g", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))

Concordance technique

Gaine du nerf optique	N	habituelle N = 95	Interface vitré N = 95	p-valeur
value	190			0,27
Moyenne ± ET		4.71 ± 0.65	4.77 ± 0.55
Min, Max		3.30, 6.50	3.70, 6.20
1 Paired t-test

vvn <- var.test(zz$value~zz$name, alternative ="two.sided")
vvn <- beaup(vvn$p.value, affp = 1)

vvg <- var.test(zg$value~zg$name, alternative ="two.sided")
vvg <- beaup(vvg$p.value, affp = 1)

mesure = c("Nerf optique", "Gaine du nerf optique")
pvalue <- c(vvn, vvg)
             
vv <- tibble(mesure, pvalue) 

names(vv)[2] <- "Comparaison des variances"

  if (expx) {
      vv |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "tab-echvar", append = TRUE)
    }
vv |> 
kbl() |>  
  kable_material(c("striped", "hover"))

mesure	Comparaison des variances
Nerf optique	p = 0,467
Gaine du nerf optique	p = 0,109

Pour la mesure du nerf optique la technique à l'interface vitrée a tendance est être plus petite que la mesure habituelle. Pas de différence pour la mesure de la gaine.Mais la précision est la même, il n’y a pas de différence entre les variances des deux méthodes.

Selon l’expert

Il n’y a aucune mesure utilisable pour le Dr OTTAVIANI.

tab <- tech2 |> 
  dplyr::filter(structure == "nerf optique") |> 
dplyr::filter(expert != "OTTAVIANI") |> 
mutate(expert = factor(expert)) |>
  drop_na() |>
 dplyr::select(expert,dif) |> 
  tbl_summary(by = expert,
type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
 add_p(test = list(
          all_continuous() ~ "t.test")) |> 
      add_n() |> 
  bold_labels() |>
  bold_p() |> 
  modify_header(label ~ "**Nerf optique**") 
  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "techexpn", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))

Différence des mesures entre les deux méthodes selon l'expert

Nerf optique	N	AL TABAA N = 56	ESPITIA N = 39	p-valeur
Différence des mesures	95			0,012
Moyenne ± ET		0.24 ± 0.20	0.39 ± 0.33
Min, Max		0.00, 0.98	0.00, 1.40
1 test de Student

tab <- tech2 |> 
  dplyr::filter(structure != "nerf optique") |> 
dplyr::filter(expert != "OTTAVIANI") |> 
mutate(expert = factor(expert)) |>
  drop_na() |>
 dplyr::select(expert,dif) |> 
  tbl_summary(by = expert,
type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
 add_p(test = list(
          all_continuous() ~ "t.test")) |> 
      add_n() |> 
  bold_labels() |>
  bold_p() |> 
  modify_header(label ~ "**Gaine du nerf optique**") 
  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "techexpg", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))

Différence des mesures entre les deux méthodes selon l'expert

Gaine du nerf optique	N	AL TABAA N = 56	ESPITIA N = 39	p-valeur
Différence des mesures	95			<0,001
Moyenne ± ET		0.16 ± 0.14	0.65 ± 0.50
Min, Max		0.00, 0.63	0.00, 1.90
1 test de Student

Validation des lecteurs

On compare ici les mesures de chaque lecteur avec la moyenne des trois experts.

exp <- tt |> 
  drop_na() |> 
  dplyr::filter(lecteur != "échographiste formé") |> 
  pivot_longer(cols = nerf_droit:gaine_gauche,values_to = "mesure") |> 
 mutate(coupe2= paste0(coupe, name)) |>  
group_by(coupe2) |> 
  summarise(round(mean(mesure),2))

lect <- tt |> 
  dplyr::filter(lecteur == "échographiste formé") |> 
    pivot_longer(cols = nerf_droit:gaine_gauche,values_to = "mesure") |> 
 mutate(coupe2= paste0(coupe, name))

el <- left_join(exp,lect, by = "coupe2") |> 
  dplyr::select(- c(coupe2, lecteur, coupe)) 

names(el) <- c("moy_exp",  "structure", "mes_lecteur")

el <- el |> 
  mutate(dif = round(abs(moy_exp - mes_lecteur),2)) |> 
  mutate(erreur = as.factor(ifelse(dif > 0.999, "Erreur", "Correct"))) |> 
mutate(structure = fct_recode(structure,
    "Gaine du nerf optique" = "gaine_droit",
    "Gaine du nerf optique" = "gaine_gauche",
    "Nerf optique" = "nerf_droit",
    "Nerf optique" = "nerf_gauche"
  )) |> 
relocate(structure, .before = moy_exp)

var_label(el) <-  c("Structure", "Moyenne des experts", "Mesure du lecteur" ,"Différence", "Validation")

tab <- el |> 
mutate(dif = cell_spec(dif, color = ifelse(dif > 0.999, "red", "black"))) |> 
  mutate(erreur = cell_spec(erreur, color = ifelse(erreur =="Erreur", "red", "black"))) 
  if (expx) {
      tab |>
        write_ods(path = classeur, sheet = "vallect", append = TRUE)
    }
tab |> 
  kbl(escape = F) |>
   kable_material(c("striped", "hover"))

structure	moy_exp	mes_lecteur	dif	erreur
Gaine du nerf optique	5,68	5,56	0,12	Correct
Gaine du nerf optique	5,02	5,08	0,06	Correct
Nerf optique	3,88	3,90	0,02	Correct
Nerf optique	3,33	3,75	0,42	Correct
Gaine du nerf optique	3,96	4,20	0,24	Correct
Gaine du nerf optique	3,79	3,91	0,12	Correct
Nerf optique	2,72	3,00	0,28	Correct
Nerf optique	2,51	2,92	0,41	Correct
Gaine du nerf optique	5,07	5,46	0,39	Correct
Gaine du nerf optique	5,02	5,45	0,43	Correct
Nerf optique	3,58	3,83	0,25	Correct
Nerf optique	3,62	3,90	0,28	Correct
Gaine du nerf optique	4,51	4,49	0,02	Correct
Gaine du nerf optique	4,38	4,84	0,46	Correct
Nerf optique	3,15	3,48	0,33	Correct
Nerf optique	3,04	3,80	0,76	Correct
Gaine du nerf optique	4,30	4,41	0,11	Correct
Gaine du nerf optique	4,20	4,45	0,25	Correct
Nerf optique	2,97	3,80	0,83	Correct
Nerf optique	2,86	3,51	0,65	Correct
Gaine du nerf optique	4,62	4,62	0	Correct
Gaine du nerf optique	4,51	4,72	0,21	Correct
Nerf optique	3,00	3,51	0,51	Correct
Nerf optique	3,22	3,79	0,57	Correct
Gaine du nerf optique	4,27	4,59	0,32	Correct
Gaine du nerf optique	4,64	4,83	0,19	Correct
Nerf optique	3,24	3,74	0,5	Correct
Nerf optique	3,24	3,62	0,38	Correct
Gaine du nerf optique	4,36	4,73	0,37	Correct
Gaine du nerf optique	4,64	4,71	0,07	Correct
Nerf optique	3,04	3,51	0,47	Correct
Nerf optique	3,39	4,04	0,65	Correct
Gaine du nerf optique	4,53	4,06	0,47	Correct
Gaine du nerf optique	4,65	4,69	0,04	Correct
Nerf optique	2,43	2,73	0,3	Correct
Nerf optique	2,18	3,42	1,24	Erreur
Gaine du nerf optique	4,89	5,32	0,43	Correct
Gaine du nerf optique	4,22	5,02	0,8	Correct
Nerf optique	3,23	4,09	0,86	Correct
Nerf optique	2,99	3,47	0,48	Correct

Le lecteur testé ici a fait une erreur sur quarante mesures.